#!/usr/bin/perl

use strict;

my $f_sScript = "utReport.pl";
my $f_sDescrip = "Creates an HTML report of the current definition of unit test scripts for rbq-lua api functions";

#-----------------------------------------------------------------------------------------------------------------
# Foffi
#-----------------------------------------------------------------------------------------------------------------
sub Foffi
{
	my $sFile = shift;
	return "Error: failed opening file '$sFile' for input";
}# Foffi

#-----------------------------------------------------------------------------------------------------------------
# OutputHtmlHeader
#-----------------------------------------------------------------------------------------------------------------
sub OutputHtmlHeader
{
	my $sTitle = shift;
	my $sH2 = shift;

	print( "<html>\n" );
	print( "<head>\n" );
	print( "<title>$sTitle</title>\n" );
	print( "<link rel=stylesheet type=\"text/css\" href=\"style.css\">\n" );
	print( "</head>\n" );
	print( "<body>\n" );
	print( "<div align=right><a href=\"index.html\">[Up]</a></div>\n" );
	print( "<center>\n" );
	print( "<h1>$sTitle</h1>\n" );
	if( $sH2 )
		{ print( "<h2>$sH2</h2>\n" ); }
	print( "<!-- generated by $f_sScript -->\n" );
	print( "</center>\n" );

}# OutputHtmlHeader

#-----------------------------------------------------------------------------------------------------------------
# OutputHtmlFooter
#-----------------------------------------------------------------------------------------------------------------
sub OutputHtmlFooter
{
	print( "</body>\n" );
	print( "</html>\n" );
}# OutputHtmlFooter

#-----------------------------------------------------------------------------------------------------------------
# GetUnitTestInfo
#
# descrip:
#		Reads param unit test file to extract information from it.  Currently, just creation date and authors
#		info is extracted.  This is the unit test script that is located in the funcs/rbq_XXXX/ subdir where
#		rbq_XXXX is the name of the unit test.
#
# params:
#		$sTestFilename
#
# returns:
#		Hash containing info about the unit test: ('creationDate => sDate', 'authors' => sAuthors ).
#
#-----------------------------------------------------------------------------------------------------------------
sub GetUnitTestInfo
{
	my @infoFields = ( "testName", "creationDate", "authors" );

	my %funcInfo;

	my $sTestFilename = shift;
	open( FIN, "<$sTestFilename" ) or die Foffi( $sTestFilename );
	my $sLine;
	while( $sLine = <FIN> )
	{
		$sLine =~ tr/\r\n//;
		# iterate all info keys to see if one is on this line
		my $sKey;
		foreach $sKey ( @infoFields )
		{
			my ($sVal) = ($sLine =~ /-- $sKey:\s+(.+)/);
			if( $sVal )
			{
				$funcInfo{$sKey} = $sVal;
				last;
			}
		}
	}
	close( FIN );

	# make sure we grabbed all needed info fields from file
	my $sKey;
	foreach $sKey ( @infoFields )
	{
		if( !$funcInfo{$sKey} )
		{
			my $sTag = "-- $sKey: ";
			die( "Error: failed finding info line containing tag '$sTag' in file '$sTestFilename'" );
		}
	}

	return %funcInfo;
}# GetUnitTestInfo

#-----------------------------------------------------------------------------------------------------------------
# GetFunctionInfo
#
# descrip:
#		Returns an array of hash refs where each hash contains information about an rbq-lua api function.
#		This is done by running a helper script to compile a list of all rbqlua function names from the 
#		cpp source file.  Then subdirs are iterated to look for all unit tests that are defined for the functions.
#
# params:
#
# returns:
#		Array of refs to hashes where each hash holds info about an rbq-lua api function.
#
#-----------------------------------------------------------------------------------------------------------------
sub GetFunctionInfo
{
	# run script to generate list of all funcs from cpp file
	my $sScript = "listFuncs.pl";
	my $sCppFile = "../../src/rbqLua/CRbqLua.cpp";
	my $sFuncsFile = "rbqFuncs.lst";
	my $sCmd = "perl -w $sScript $sCppFile $sFuncsFile";
	my $rc = system( $sCmd );
	if( $rc != 0 )
	{
		die( "Failed running command '$sCmd', rc=$rc" );
	}

	# read list of funcs from file
	my @funcsRet;
	open( FIN, "<$sFuncsFile" ) or die( Foffi( $sFuncsFile ));
	my $sLine;
	while( $sLine = <FIN> )
	{
		$sLine =~ tr/\r\n//d;
		my $sFuncName = $sLine;
		my %funcInfo = ( 'name' => $sFuncName );
		push( @funcsRet, \%funcInfo );
	}
	close( FIN );

	# now, iterate subdirs to look for unit tests defined for these funcs
	my @subDirs = glob( "funcs/*" );
	my $sDir;
	foreach $sDir ( @subDirs )
	{
		# skip CVS dir
		if( $sDir eq "funcs/CVS" )
			{ next; }

		# open test file and get info from it
		my $sTestFile = "$sDir/test.lua";
		if( ! -e $sTestFile )
		{
			$sTestFile = "$sDir/tickTest.lua";
		}
		my %utInfo = GetUnitTestInfo( $sTestFile );
		my $sFuncName = $utInfo{'testName'};
		my $rhFunc = undef;

		# find ref to hash for this function in return array
		my $rhfr;
		foreach $rhfr (@funcsRet)
		{
			my $sName = $$rhfr{'name'};
			if( $sName eq $sFuncName )
			{
				$rhFunc = $rhfr;
				last;
			}
#print( "funcName='$sName'\n" );
		}
		if( !$rhFunc )
		{
			die( "Error: failed finding function with name '$sFuncName' in list of functions" );
		}

		# add ut hash info to return info
		$$rhFunc{'creationDate'} = $utInfo{'creationDate'};
		$$rhFunc{'authors'} = $utInfo{'authors'};
	}

	# return list of hashes
	return @funcsRet;
}# GetFunctionInfo

#-----------------------------------------------------------------------------------------------------------------
# PrintTable
#-----------------------------------------------------------------------------------------------------------------
sub PrintTable
{
	my $raFuncs = shift;

	# table, sorted by name
	# table header
	print( "<table border=1 width=\"100%\">\n" );
	print( "<tr>\n" );
	print( "<th>No.\n" );
	print( "<th>Function\n" );
	print( "<th>Unit Test\n" );	
	print( "<th>Date Defined\n" );	
	print( "<th>Authors\n" );	

	# records
	my $iFunc;
	for( $iFunc = 0; $iFunc < @$raFuncs; ++$iFunc )
	{
		my $rhFuncInfo = $$raFuncs[$iFunc];
		my $sFuncName = $$rhFuncInfo{'name'};
		my $sDate = $$rhFuncInfo{'creationDate'};
		my $sAuth = $$rhFuncInfo{'authors'};
		# define cvs link for funcs with defined unit test
		my $sUtData = "&nbsp;";
		if( $sDate )
		{
			my $sCvsLink = "http://cvs.sourceforge.net/viewcvs.py/rbuilder/bas/app/rbq/tst/rbqlua/funcs/$sFuncName/test.lua?view=markup";
			$sUtData = "<a href=\"$sCvsLink\">CVS</a>";
		}
		
		# put spaces in empty table data items
		if( !$sDate )
		{
			$sDate = "&nbsp;"
		}
		if( !$sAuth )
		{
			$sAuth = "&nbsp;"
		}
		my $sDocLink = "rbq_lua.html#$sFuncName";
		my $iNum = $iFunc + 1;
		print( "<tr><td>$iNum<td><a href=\"$sDocLink\">$sFuncName</a> <td>$sUtData	<td>$sDate	<td>$sAuth\n" );
	}
	# table footer
	print( "</table>\n" );

}# -- PrintTable

#-----------------------------------------------------------------------------------------------------------------
# DateSortSub
#-----------------------------------------------------------------------------------------------------------------
sub DateSortSub
{
	my $rhFuncA = $a;
	my $rhFuncB = $b;
	my $sDateA = $$rhFuncA{'creationDate'};
	my $sDateB = $$rhFuncB{'creationDate'};
	if( !$sDateA )
	{
		# if neither has date defined, compare by name
		if( !$sDateB )
		{
			my $sNameA = $$rhFuncA{'name'};
			my $sNameB = $$rhFuncB{'name'};
			return $sNameA cmp $sNameB;
		}
		# date for b is defined, it comes first
		else
		{
			return 1;
		}
	}
	# date for a is defined, it comes first
	elsif( !$sDateB )
	{
		return -1;
	}

	# dates are defined for both a and b
	return $sDateA cmp $sDateB;
}# DateSortSub

#-----------------------------------------------------------------------------------------------------------------
# GetTotalUnitTests
#-----------------------------------------------------------------------------------------------------------------
sub GetTotalUnitTests
{
	my $raFuncs = shift;
	my $iTotalDefs = 0;

	# iterate records, count defined tests
	my $iFunc;
	for( $iFunc = 0; $iFunc < @$raFuncs; ++$iFunc )
	{
		my $rhFuncInfo = $$raFuncs[$iFunc];
		my $sDate = $$rhFuncInfo{'creationDate'};
		if( $sDate )
		{
			$iTotalDefs = $iTotalDefs + 1;
		}
	}

	return $iTotalDefs;

}# GetTotalUnitTests

#-----------------------------------------------------------------------------------------------------------------
# main
#-----------------------------------------------------------------------------------------------------------------

	# -- output html report
	my $sTitle = "Progress Report";
	my $sH2 = "Creation of Unit Tests for Rbq - Lua Interface Functions";
	OutputHtmlHeader( $sTitle, $sH2 );

	# -- output completion stats
	print( "<center>\n" );
	my @funcs = GetFunctionInfo();
	my $iTotalFuncs = @funcs;
	my $iTotalDefs = GetTotalUnitTests( \@funcs );
	my $fPct = 100 * ($iTotalDefs / $iTotalFuncs);
	my $sPct = sprintf( "%2.1f", $fPct );
	print( "<h3>$iTotalDefs tests defined for $iTotalFuncs functions ($sPct % done)</h3>\n" );
	my $sDate = localtime();
	print( "<h4>last updated $sDate</h4>\n" );
	print( "</center>\n" );

	print( "<ul>\n" );
	print( "<li><a href=\"#dateList\">List of functions, sorted by unit test creation date</a>\n" );
	print( "<li><a href=\"#nameList\">List of functions, sorted by function name</a>\n" );
	print( "</ul>\n" );


	# -- print list of functions, sorted by date
	print( "<hr>\n" );
	print( "<a name=\"dateList\">\n" );
	print( "<h2>List of functions, sorted by unit test creation date</h2>\n" );
	print( "</a>\n" );
	my @sortFuncs = sort DateSortSub @funcs;
	PrintTable( \@sortFuncs );

	# -- print list of functions, sorted by name
	print( "<hr>\n" );
	print( "<a name=\"nameList\">\n" );
	print( "<h2>List of functions, sorted by function name</h2>\n" );
	print( "</a>\n" );
	PrintTable( \@funcs );

	OutputHtmlFooter();

